home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
PARSEREQ.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
9KB
|
317 lines
UNIT ParseReq;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Statemachine to handle file requests Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos,
PoPTypes, NetFile;
TYPE
ReqTmpVarType=RECORD
Found : Boolean;
NextState : Byte;
ReqTime,
OKName, ReqName : S20;
ReqPwd : S80;
RawReqName, Nfts,
ReqLine, ReqFileName : PathStr;
ReqFile, OkFile : TNetFile;
END;
VAR
ReqFilesOpen : Boolean;
TempSr, ReqSr : SearchRec;
FUNCTION InitReqFile(Net, Node: Integer): Boolean;
FUNCTION GetNextFileToSend(VAR FreeArea: TFreeArea): PathStr;
PROCEDURE CloseReqFiles;
IMPLEMENTATION
USES OpCrt, OpDate, OpDos, OpString,
Globals, Com, FileUtil, UnixDate, MailUtil, StrUtil, PTpl, LogFile,
Util;
CONST
Rt : ^ReqTmpVarType = NIL;
FUNCTION InitReqFile(Net, Node: Integer): Boolean;
BEGIN
New(Rt);
ReqFilesOpen:=False;
InitReqFile:=False;
Rt^.Found:=False;
RspFile:=HoldFileName(Call,True)+'RSP';
Rt^.ReqFileName:=MakeReqFileName(Net, Node, GlobNodeStat);
IF NOT Rt^.ReqFile.OpenWithMode(Rt^.ReqFileName, 1, False, ShareRW+ShareDenyW) THEN
BEGIN
CloseReqFiles;
Exit;
END;
IF NOT Rt^.OkFile.Open(StartPath+PoPOkFileName,SizeOf(TOkFile),False) THEN
BEGIN
AddLog('!','Can''t open PORTAL.OKF');
CloseReqFiles;
Exit;
END;
ReqFilesOpen:=True;
AddLog(' ','NodeStat: '+Long2Str(Ord(GlobNodeStat))+' = Files: '+Long2Str(MaxReqFiles)+
' Bytes: '+Long2Str(MaxReqBytes)+
' Time: '+TimeToTimeString('hh:mm:ss',MaxReqTime));
Rt^.NextState:=1;
InitReqFile:=TRUE;
StartTime:=CurrentTime;
END;
FUNCTION GetNextFileToSend(VAR FreeArea: TFreeArea): PathStr;
VAR
OkFileRec : TOkFile;
PROCEDURE ReadNextReqLine;
VAR
s:String;
i,p:BYTE;
ch:char;
BEGIN
Rt^.OkFile.Seek(0);
Rt^.Found:=False;
REPEAT
Rt^.ReqFile.ReadLine(Rt^.ReqLine) ;
UNTIL Rt^.ReqFile.EoF OR ((Rt^.ReqLine<>'') AND (Copy(Rt^.ReqLine,1,1)<>';'));
IF Rt^.ReqFile.EoF AND (Rt^.ReqLine='') THEN
BEGIN
Rt^.NextState:=5;
Exit;
END;
Rt^.ReqLine:=StUpCase(Rt^.ReqLine);
Rt^.ReqName:='';
Rt^.ReqPwd:='';
Rt^.ReqTime:='';
FOR i:=1 TO WordCount(Rt^.reqline, [' ']) DO
BEGIN
s:=ExtractWord(i, Rt^.reqline, [' ']);
Ch:=s[1];
IF i>1 THEN
BEGIN
CASE Ch OF
'!' : Rt^.reqpwd:=Copy(s, 2, 255);
'+' : Rt^.reqtime:=Copy(s, 2, 255);
END;
END ELSE
IF Ch<>#0 THEN Rt^.ReqName:=s;
END;
IF Rt^.ReqName='' THEN Exit;
JustFileName(CleanPathName(Trim(Rt^.reqname)));
Rt^.rawreqname:=Rt^.reqname;
AddLog('+', 'File Request: `'+Rt^.rawreqname+'''');
IF Rt^.NextState<>5 THEN
BEGIN
Rt^.NextState:=2;
p:=pos('.', Rt^.reqname);
IF p>0 THEN
BEGIN
Rt^.reqname:=CPad(Copy(Rt^.ReqName,1,p-1), 8)+Pad(Copy(Rt^.reqname, p, 4),4);
p:=pos('*', Rt^.reqname);
IF p IN [1..8] THEN
FOR i:=p TO 8 DO
Rt^.reqname[i]:='?';
p:=pos('*', Rt^.reqname);
IF p > 9 THEN
FOR i:=p TO 12 DO
Rt^.reqname[i]:='?';
END ELSE
Rt^.ReqName:=CPad(Rt^.ReqName,8)+'. ';
{
AddLog('*', 'CONVERTED REQ NAME: "'+ReqName+'"');
}
END;
END;
PROCEDURE ReadNextOkLine;
VAR
i,p : Byte;
BEGIN
Rt^.OkFile.Read(OkFileRec, NoKeep, Wait);
IF Rt^.OkFile.IoResult<>0 THEN
BEGIN
Rt^.NextState:=1;
IF NOT Rt^.Found THEN
BEGIN
ReqSr.Name:=Rt^.rawreqname;
ReqSr.size:=0;
ReqSr.Time:=0;
AddTpl(rspfile,'NOTFOUND', ReqSr);
AddLog('#','Requested file not found: '+Rt^.RawReqName);
END;
Exit;
END ELSE
BEGIN
Rt^.NextState:=3;
FreeArea:=OkFileRec.FreeArea;
END;
IF ((OkFileRec.Password<>'') AND (OkFileRec.Password<>Rt^.reqpwd)) OR (OkFileRec.NodeStat>GlobNodeStat) OR
(OkFileRec.Level>NodesRec.Level) OR
((NodesRec.Keys AND OkFileRec.Keys)<>OkFileRec.Keys) OR
((OkFileRec.TaskNumber<>0) AND (OkFileRec.TaskNumber<>Cfg.TaskNumber)) THEN
BEGIN
Rt^.NextState:=2;
Exit;
END;
Rt^.OKName:='';
IF OkFileRec.MagicName='' THEN
BEGIN
{ normal f.req. }
okpath:=OkFileRec.FilePath;
Rt^.OKName:=JustFileName(okpath);
okpath[0]:=Chr(Length(okpath)-Length(Rt^.OKName)-1);
{
IF NOT chkdir(okpath) THEN
BEGIN
AddLog('!', 'OKFile error: "'+okpath+'" does not exist');
NextState:=2;
Exit;
END;
}
p:=pos('.', Rt^.OKName);
IF p=0 THEN
Rt^.OKName:=CPad(Rt^.OKName,8)+'. '
ELSE
Rt^.OKName:=Pad(Copy(Rt^.OKName, 1, p-1),8)+Pad(Copy(Rt^.OKName, p, 4),4);
p:=pos('*', Rt^.OKName);
IF p IN [1..8] THEN
FOR i:=p TO 8 DO
Rt^.OKName[i]:='?';
p:=pos('*', Rt^.OKName);
IF p > 9 THEN
FOR i:=p TO 12 DO
Rt^.OKName[i]:='?';
FOR i:=1 TO 12 DO
IF (Rt^.reqname[i]<>'?') AND (Rt^.OKName[i]='?') THEN Rt^.OKName[i]:=Rt^.reqname[i];
END ELSE
BEGIN
{ Magic filename }
IF StUpCase(OkFileRec.MagicName)=StUpCase(Rt^.RawReqName) THEN
BEGIN
okpath:=OkFileRec.FilePath;
Rt^.OKName:=JustFileName(okpath);
okpath[0]:=Chr(Length(okpath)-Length(Rt^.OKName)-1);
END ELSE
Rt^.NextState:=2;
END;
Replace(Rt^.OKName, ' ', '', 0);
END;
PROCEDURE FindFirstFileToSend;
VAR
dt:DateTime;
reqtimenum,u:LongInt;
test:WORD;
FUNCTION HaveJoker(CONST FName: PathStr): Boolean;
BEGIN
HaveJoker:=(Pos('*', FName)>0) OR (Pos('?',FName)>0);
END;
BEGIN
FindFirst(OkPath+'\'+Rt^.OKName, Archive+ReadOnly, ReqSr);
IF DosError<>0 THEN
BEGIN
Rt^.NextState:=2;
IF DOSError=3 THEN AddLog('!', 'OKFile error: "'+okpath+'" does not exist');
END ELSE
BEGIN
Rt^.NextState:=4;
{ IF NOT HaveJoker(RawReqName) AND
((OkFileRec.MagicName='') OR NOT HaveJoker(OkFileRec.FilePath)) THEN
NextState:=1;}
IF Cfg.Request.SkipAfterFirst THEN
IF NOT HaveJoker(Rt^.RawReqName) AND (OkFileRec.MagicName='') THEN Rt^.NextState:=1;
IF Rt^.ReqTime<>'' THEN
BEGIN
UnPackTime(ReqSr.Time, Dt);
WITH Dt DO
u:=GetUnixDate(Year, Month, Day, Hour, Min, Sec);
Val(Rt^.reqtime, reqtimenum, test);
END;
IF (Rt^.ReqTime='') OR ((Rt^.ReqTime<>'') AND (reqtimenum<u)) THEN
BEGIN
Rt^.Nfts:=OkPath+'\'+ReqSr.Name;
Rt^.Found:=True;
END;
END;
END;
PROCEDURE FindNextFileToSend;
VAR
dt:DateTime;
reqtimenum,u:LongInt;
test:WORD;
BEGIN
FindNext(ReqSr);
IF DosError<>0 THEN Rt^.NextState:=2 ELSE
BEGIN
Rt^.NextState:=4;
IF Rt^.reqtime <> '' THEN
BEGIN
UnPackTime(ReqSr.Time, Dt);
WITH Dt DO
u:=GetUnixDate(Year, Month, Day, Hour, Min, Sec);
Val(Rt^.reqtime, reqtimenum, test);
END;
IF (Rt^.reqtime='') OR ((Rt^.ReqTime<>'') AND (ReqTimeNum<u)) THEN
BEGIN
Rt^.Nfts:=OkPath+'\'+ReqSr.Name;
Rt^.Found:=True;
END;
END;
END;
BEGIN
Rt^.nfts:='';
doserror:=0;
IF ExistFile(Rt^.ReqFileName) THEN
BEGIN
REPEAT
CASE Rt^.NextState OF
1 : ReadNextReqLine;
2 : ReadNextOkLine;
3 : FindFirstFileToSend;
4 : FindNextFileToSend;
END;
UNTIL (Rt^.NextState=5) OR (Rt^.nfts<>'') OR NOT ComPort^.Carrier;
END;
GetNextFileToSend:=Rt^.nfts;
IF (Rt^.nfts='') OR NOT ComPort^.Carrier THEN CloseReqFiles;
END;
PROCEDURE CloseReqFiles;
BEGIN
FindClose(ReqSr);
IF ReqFilesOpen THEN
BEGIN
Rt^.ReqFile.Close;
DeleteFile(Rt^.ReqFileName);
Rt^.OkFile.Close;
ReqFilesOpen:=False;
END;
IF Rt<>NIL THEN
BEGIN
Dispose(Rt);
Rt:=NIL;
END;
END;
BEGIN
ReqFilesOpen:=False;
END.